unit fpg_salelistbox;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, fpg_main, fpg_listbox, fpg_base, fpstructs;

type

  { TSaleLine }
  TSaleLine = class(TObject)
  public
    Product: TfpProduct;
    Quantity: integer;
//    Discount: single;
    isRefund: Boolean;
    isDiscount: Boolean;
  end;

  TDiscountItem = record
    discountid: integer;
    description: string;
    discounttype: integer;
    starttime: TDateTime;
    endtime: TDateTime;
    triggerqty: integer;
    discount: Double;
    itemcount: integer;
    balance: Double;
  end;

  TDiscountItemArray = array of TDiscountItem;

  { TDiscounter }

  TDiscounter = class(TObject)
    fitems: TDiscountItemArray;
    ftotal: Double;
  private
    FCount: integer;
    function GetDiscountIndex(discountid: integer): integer;
  public
    constructor Create;
    procedure AddDiscount(value: TDiscountItem);
    procedure DeleteDiscount(idx: integer);
    procedure AddItem(aproduct: TfpProduct; quantity: integer);
    procedure RemoveItem(aproduct: TfpProduct; quantity: integer);
    procedure RefreshTotal;
    procedure ResetDiscounts;
    procedure Clear;
    property Items: TDiscountItemArray read fitems;
    property TotalDiscount: Double read ftotal;
    property Count: integer read FCount;
  end;

  { TfpgSaleListbox }

  TfpgSaleListbox = class(TfpgListBox)
  private
    FisRefund: Boolean;
    FSaleCount: integer;
    FSaleTotal: Double;
    function GetCount: integer;
  protected
    procedure DrawItem(num: integer; rect: TfpgRect; flags: integer); override;
  public
    Discounts: TDiscounter;
    constructor Create ( AOwner: TComponent ) ; override;
    destructor Destroy; override;
    function RowHeight: integer; override;
    function ItemInSaleList ( itemid: integer ) : integer;
    procedure RefreshSaleTotal;
    procedure Clear;
    property Count: integer read GetCount;
    property SaleCount: integer read FSaleCount write FSaleCount;
    property SaleTotal: Double read FSaleTotal;
    procedure ResetSale;
    procedure AddItem(  aproduct: TfpProduct; salequantity: Integer=1 );
    procedure DeleteItem( idx: integer );
    procedure AdjustQuantity( idx: integer; adjust: integer );
    property isRefund: Boolean read FisRefund write FisRefund;
  end;

implementation

{ TDiscounter }

procedure TDiscounter.AddDiscount ( value: TDiscountItem ) ;
begin
  Inc(FCount);
  if FCount>Length(fitems)
     then SetLength(fitems, Count+16);
  fitems[FCount-1] := value;
  fitems[FCount-1].itemcount := 0;
  fitems[FCount-1].balance := 0.0;
end;

procedure TDiscounter.DeleteDiscount ( idx: integer ) ;
var
  x: Integer;
begin
  Dec(FCount);
  for x := idx to FCount-1 do
    fitems[x] := fitems[x+1];
end;

procedure TDiscounter.AddItem ( aproduct: TfpProduct; quantity: integer ) ;
var
  dc: TDiscountItem;
  dix: integer;
begin
  writeln('TDiscounter.AddItem');
  if aproduct.discount<1 then Exit;
  dix := GetDiscountIndex(aproduct.discount);
  writeln('Index: ', dix);
  if dix<0 then exit;
  dc := fitems[dix];
  if dc.discountid>0 then
    begin
      dc.itemcount := dc.itemcount+quantity;
      if dc.itemcount<0 then dc.itemcount := 0;
      dc.balance := (dc.itemcount div dc.triggerqty) * dc.discount;
      WriteLn('Discount: ', FormatFloat('0.00', dc.balance));
      writeln('Itemcount: ', dc.itemcount);
      fitems[dix] := dc;
      RefreshTotal;
    end;
end;

procedure TDiscounter.RemoveItem ( aproduct: TfpProduct; quantity: integer ) ;
begin
  AddItem(aproduct, -quantity);
end;

procedure TDiscounter.RefreshTotal;
var
  tot: Extended;
  x: Integer;
begin
  tot := 0.0;
  for x := 0 to FCount-1 do
    tot := tot + fitems[x].balance;
  ftotal := tot;
end;

procedure TDiscounter.ResetDiscounts;
var
  x: Integer;
begin
  ftotal := 0.0;
  for x := 0 to FCount-1 do
    begin
      fitems[x].itemcount := 0;
      fitems[x].balance := 0.0;
    end;
end;

procedure TDiscounter.Clear;
begin
  FCount := 0;
  ftotal := 0.0;
end;

function TDiscounter.GetDiscountIndex(discountid: integer): integer;
var
  x: Integer;
begin
  Result := -1;
  x := 0;
  while (x<FCount) and (Result<0) do
        begin
          if fitems[x].discountid=discountid
             then Result := x;
          Inc(x);
        end;
end;

constructor TDiscounter.Create;
begin
  fCount := 0;
  SetLength(fitems, 16);
end;

{ TfpgSaleListbox }

function TfpgSaleListbox.GetCount: integer;
begin
  Result := ItemCount;
end;

procedure TfpgSaleListbox.DrawItem(num: integer; rect: TfpgRect; flags: integer
  );
var
  price: String;
  itemname: string;
  quantity: String;
begin
    if Items.Objects[num]<>nil then
      begin
        price := FormatFloat('0.00',TSaleLine( Items.Objects[num]).Product.saleprice * TSaleLine( Items.Objects[num]).Quantity);
        itemname := TSaleLine( Items.Objects[num]).Product.name;
        quantity := IntToStr(TSaleLine( Items.Objects[num]).Quantity) + 'x   @ ' + FormatFloat('0.00', TSaleLine( Items.Objects[num]).Product.saleprice);
      end;
    fpgStyle.DrawString(Canvas, rect.left+4, rect.top+1, itemname, Enabled);
    fpgStyle.DrawString(Canvas, rect.left+4, rect.Bottom-FFont.Height-2, quantity, Enabled);
    Canvas.DrawText(rect.left, rect.Bottom-FFont.Height-2, Width-8, Height - 8, price, [txtRight], 2);
    Canvas.DrawBevel(rect.Left, rect.Bottom, rect.Right-rect.Left, 1);
end;

constructor TfpgSaleListbox.Create ( AOwner: TComponent ) ;
begin
  inherited Create ( AOwner ) ;
  Discounts := TDiscounter.Create;
end;

destructor TfpgSaleListbox.Destroy;
begin
  Discounts.Free;
  inherited Destroy;
end;

function TfpgSaleListbox.RowHeight: integer;
begin
  Result := (FFont.Height + 2) * 2 ;
end;

function TfpgSaleListbox.ItemInSaleList(itemid: integer): integer;
var
  x: Integer;
begin
  Result := -1;
  if itemid<1 then Exit;  // manually entered so needs a line to itself
  x:=0;
  while (x < Items.Count) and (Result < 0) do
        begin
        if TSaleLine(Items.Objects[x]).Product.id = itemid
           then Result := x;
        Inc(x);
        end;
end;

procedure TfpgSaleListbox.RefreshSaleTotal;
var
  tot: Extended;
  x: Integer;
  qty: Integer;
begin
  tot := 0.0;
  qty := 0;
  for x := 0 to ItemCount-1 do
    begin
      tot := tot + (TSaleLine(Items.Objects[x]).Product.saleprice*TSaleLine(Items.Objects[x]).Quantity);
      if TSaleLine(Items.Objects[x]).Quantity>0
         then qty := qty + TSaleLine(Items.Objects[x]).Quantity;
    end;
  tot := tot - Discounts.TotalDiscount;
  FSaleTotal := tot;
  FSaleCount := qty;
end;

procedure TfpgSaleListbox.Clear;
begin
  Items.Clear;
  Discounts.ResetDiscounts;
end;

procedure TfpgSaleListbox.ResetSale;
var
  x: Integer;
begin
  for x := Count-1 downto 0 do
    begin
      TSaleLine(Items.Objects[x]).Free;
    end;
  Clear;
  FSaleCount := 0;
  FSaleTotal := 0.0;
end;

procedure TfpgSaleListbox.AddItem ( aproduct: TfpProduct; salequantity: Integer=1 ) ;
var
  x: LongInt;
  SaleItem: TSaleLine;
begin
  SaleItem := TSaleLine.Create;
  if self.fisRefund then aproduct.saleprice := 0-aproduct.saleprice;
  with SaleItem do
      begin
        Product := aproduct;
        Quantity := salequantity;
        isRefund := Self.fisRefund;
      end;
  Items.AddObject(SaleItem.Product.name, SaleItem);
  if FisRefund
    then Discounts.RemoveItem(aproduct, salequantity)
    else Discounts.AddItem(aproduct, salequantity);
  RefreshSaleTotal;
  Self.Invalidate;
end;

procedure TfpgSaleListbox.DeleteItem ( idx: integer ) ;
begin
  if (idx=-1) or (idx>=Count) then exit;
  FSaleTotal := FSaleTotal - TSaleLine(Items.Objects[idx]).Quantity * TSaleLine(Items.Objects[idx]).Product.saleprice;
  FSaleCount := FSaleCount - TSaleLine(Items.Objects[idx]).Quantity;
  Items.Delete(idx);
  Invalidate;
end;

procedure TfpgSaleListbox.AdjustQuantity ( idx: integer; adjust: integer ) ;
begin
  if (idx=-1) or (idx>=Count) then exit;
  FSaleTotal := FSaleTotal + (TSaleLine(Items.Objects[idx]).Product.saleprice*adjust);
  FSaleCount := FSaleCount + adjust;
  TSaleLine(Items.Objects[idx]).Quantity := TSaleLine(Items.Objects[idx]).Quantity+adjust;
  if TSaleLine(Items.Objects[idx]).Quantity<1
     then Items.Delete(idx);
  Invalidate;
end;

end.

